home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / floppy.f < prev    next >
Text File  |  1992-07-31  |  8KB  |  223 lines
  1.       PROGRAM FLOPPY
  2. C-------------------------------------------------------------------------
  3. C Floppy UNIX interface routine.
  4. C Sets up various required input files for Floppy.
  5. C 
  6. C Julian Bunn 1990
  7. C-------------------------------------------------------------------------
  8.       PARAMETER (MLEN=256,MXLIN=80,maxarg=100)
  9.       character*(mxlin) argval
  10.       character*1 key,char
  11.       CHARACTER*(MLEN)  CFILE,COLD,CFORT,CTEMP,CBAD,CTREE
  12.       LOGICAL LOG,fexist,fold,fqold,tidy,tree
  13. c
  14. c get all arguments
  15. c
  16.       numargs = iargc()
  17.       if(numargs.gt.maxarg) then
  18.          write(6,'(A)') ' Floppy --> Too many arguments '
  19.          goto 900
  20.       endif
  21. c
  22. c get target filename(s)
  23. c
  24.       call getarg(numargs,cfile)       
  25.       lfile = index(cfile,' ')-1
  26.       write(6,'(A)') ' Floppy --> Target file '//cfile(:lfile)
  27.       inquire(file=cfile(:lfile),exist=fexist)
  28.       if(.not.fexist) then
  29.         write(6,'(A)') ' Floppy --> Target file not found !'
  30.         goto 900
  31.       endif
  32. c
  33.       log = .false.                          
  34.       fold = .false.  
  35.       tidy = .false.
  36.       cfort = ' '
  37.       ctree = ' '
  38.       tree = .false.
  39. c
  40.       do 400 iarg=1,numargs-1
  41.          call getarg(iarg,argval)
  42.          if(argval(:2).eq.'-l') log = .true.
  43.          if(argval(:2).eq.'-o') fqold = .true.
  44.          if(argval(:2).eq.'-o') cold = argval(3:)
  45.   400 continue
  46. c
  47.       cbad = 'scratch'
  48.       open(7,status='scratch',err=999)
  49.       WRITE(7,'(A)') 'LIST,GLOBAL,TYPE;'
  50.       WRITE(7,'(A)') 'PRINT,ILLEGAL;'
  51.       WRITE(7,'(A)') 'OPTIONS,USER;'
  52.       if(fqold) then
  53.         if(cold(1:1).eq.' ') cold = cfile(:lfile)//'.flopold'
  54.         lold = index(cold,' ')-1
  55.         inquire(file=cold(:lold),exist=fold)
  56.         if(log) write(6,'(A)') ' Floppy --> Old file: '//cold(:lold)
  57.         if(.not.fold) then
  58.            write(6,'(A)') ' Floppy --> Old file not found !'
  59.            goto 900
  60.         endif
  61.         cbad = cold
  62.         open(15,file=cold,status='old',err=999)
  63.   450   read(15,'(A)',end=451,err=999) ctemp      
  64.         goto 450
  65.   451   continue
  66.       else
  67.         cold = cfile(:lfile)//'.flopold'     
  68.         lold = index(cold,' ')-1
  69.         cbad = cold
  70.         open(15,file=cold(:lold),status='unknown',err=999)
  71.       endif
  72. c
  73. c loop over all qualifiers
  74. c
  75.       icheck = 0
  76.       do 500 iarg = 1,numargs-1
  77.          call getarg(iarg,argval)
  78.          larg = index(argval,' ')-1 
  79.          key = argval(2:2)
  80.          if(key.eq.'l') then
  81.            log = .true.
  82.          else if(key.eq.'n') then
  83.            if(argval(3:3).eq.' ') then
  84.               write(6,'(A)') ' Floppy --> Missing value for -n'
  85.               goto 900
  86.            endif 
  87.            cfort = argval(3:)
  88.            lfort = index(cfort,' ')-1 
  89.            if(log) write(6,'(A)') ' Floppy --> Tidied Fortran: '//
  90.      &             cfort(:lfort) 
  91.          else if(key.eq.'o') then
  92. c
  93.          else if(key.eq.'f') then
  94.            if(log) write(6,'(A)') ' Floppy --> List source line numbers'
  95.            write(15,'(a)') '*FULL'
  96.          else if(key.eq.'i') then
  97.            ctemp = argval(3:)
  98.    50      iend = index(ctemp,',')
  99.            if(iend.ne.0) then
  100.              write(15,'(A)') ctemp(:iend-1)
  101.              if(log) write(6,'(A)') 
  102.      &         ' Floppy --> Ignore: '//ctemp(:iend-1) 
  103.              ctemp = ctemp(iend+1:)
  104.              goto 50
  105.            endif
  106.            iend = index(ctemp,' ')
  107.            write(15,'(A)') ctemp(:iend)
  108.            if(log) write(6,'(A)') ' Floppy --> Ignore: '//ctemp(:iend)
  109.          else if(key.eq.'c') then
  110.            icheck = 1
  111.            ctemp = argval(3:)
  112.            if(ctemp.eq.'standard') then
  113.              write(15,'(A)') '*CHECK RULE *'
  114.              if(log) write(6,'(A)') ' Floppy --> Check Standard rules'
  115.            else if(ctemp.eq.' ') then
  116.              write(15,'(A)') '*CHECK RULE *'
  117.              if(log) write(6,'(A)') ' Floppy --> Check Standard rules'
  118.            else if(ctemp.eq.'a') then
  119.               write(15,'(A)') '*CHECK RULE 99'
  120.               if(log) write(6,'(A)') ' Floppy --> Check all rules'
  121.            else if(ctemp.eq.'n') then
  122.              write(15,'(A)') '*CHECK RULE -99'
  123.               if(log) write(6,'(A)') ' Floppy --> No rule checks'
  124.            else 
  125.              ctemp = ctemp(:index(ctemp,' ')-1)
  126.              if(log) write(6,'(A)') ' Floppy --> Check rules: '//
  127.      &               ctemp(:index(ctemp,' ')-1)
  128.    51        iend = index(ctemp,',')
  129.              if(iend.ne.0) then
  130.                write(15,'(A)') '*CHECK RULE '//ctemp(:iend-1)
  131.                ctemp = ctemp(iend+1:)
  132.                goto 51
  133.              endif
  134.              write(15,'(A)') '*CHECK RULE '//ctemp
  135.            endif 
  136.          else if(key.eq.'t') then
  137.            write(7,'(A)') 'OPTIONS,TREE;'
  138.            ctree = cfile(:lfile)//'.floptre'
  139.            ltree = index(ctree,' ')-1
  140.            if(log) write(6,'(A)') 
  141.      &             ' Floppy --> Produce file for Flow: '//ctree(:ltree)
  142.            open(50,file=ctree(:ltree),status='new',
  143.      &          form='unformatted',err=999)
  144.            tree = .true.
  145.          else if(key.eq.'j') then
  146.            char = argval(3:3)
  147.            if(char.eq.' ') char = '3'
  148.            write(7,'(A)') 'OPTIONS,INDENT='//char//';'
  149.            if(log) write(6,'(A)') ' Floppy --> Indent clauses by '//char
  150.            tidy = .true.
  151.          else if(key.eq.'f') then
  152.            write(7,'(A)') 'STATEMENTS,SEPARATE;'
  153.            if(log) write(6,'(A)') ' Floppy --> Group FORMATs at end'
  154.            tidy = .true.
  155.          else if(key.eq.'g') then
  156.            write(7,'(A)') 'STATEMENTS,GOTO;'
  157.            if(log) write(6,'(A)') ' Floppy --> Right align GOTOs'
  158.            tidy = .true.
  159.          else if(key.eq.'r') then
  160.            ctemp = argval(3:)
  161.            iend = index(ctemp,',')
  162.            if (iend.eq.0) ctemp = ctemp(:index(ctemp,' ')-1)//',10'
  163.            write(7,'(A)') 'STATEMENTS,FORMAT='//
  164.      &                    ctemp(:index(ctemp,' ')-1)//';'
  165.            if(log) write(6,'(A)') ' Floppy --> Renumber FORMATs: '//
  166.      &             'start,step '//ctemp(:index(ctemp,' '))
  167.            tidy = .true.
  168.          else if(key.eq.'s') then
  169.            ctemp = argval(3:)
  170.            iend = index(ctemp,',')
  171.            if (iend.eq.0) ctemp = ctemp(:index(ctemp,' ')-1)//',10'
  172.            write(7,'(A)') 'STATEMENTS,NUMBER='//
  173.      &                    ctemp(:index(ctemp,' ')-1)//';'
  174.            if(log) write(6,'(A)') ' Floppy --> Renumber statements: '//
  175.      &             'start,step '//ctemp(:index(ctemp,' '))
  176.            tidy = .true.
  177.          else 
  178.            write(6,'(A)') ' Floppy --> Unrecognized qualifier '//key
  179.          endif
  180.   500 continue
  181. c
  182.       if(tidy) then
  183.          write(7,'(A)') 'OUTPUT,FULL,COMPRESS;'
  184.          if(cfort(1:1).eq.' ') then
  185.            cfort = cfile(:lfile)//'.out'
  186.            lfort = index(cfort,' ')-1
  187.          endif
  188.          cbad = cfort
  189.          open(14,file=cfort(:lfort),status='unknown',err=999)
  190.       endif 
  191. c
  192. c default action is to check standard rules
  193. c
  194.       if(icheck.eq.0.and..not.fqold) then
  195.          write(15,'(A)') '*CHECK RULE *'
  196.       endif
  197.          
  198.       write(7,'(A)') 'END;'
  199.       if(log) write(6,'(A)') ' Floppy --> Finished parsing command' 
  200.       rewind(7)
  201.       rewind(15)
  202.       cbad = cfile
  203.       open(11,file=cfile(:lfile),status='old',err=999)
  204.       cbad = 'scratch'
  205.       open(99,status='scratch',err=999)
  206. c
  207.       call allpro
  208. c
  209.       close(11)
  210.       if(tidy) close(14)
  211.       if(tree) close(50)
  212.       close(7)
  213.       close(99)
  214.       write(6,'(A)') ' Floppy --> has finished'
  215.       goto 2000
  216. C
  217.   999 CONTINUE
  218.       WRITE(6,'(A)') ' Floppy --> Error opening '//
  219.      &               cbad(:index(cbad,' ')) 
  220.   900 write(6,'(A)') ' Floppy aborted'     
  221.  2000 CONTINUE
  222.       END
  223.